home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / NUMBERS.SWG / 0033_More Get-Set Bits.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  3KB  |  120 lines
  1. {
  2. Robert Rothenburg
  3.  
  4. Here's some routines I wrote while playing around with some compression
  5. algorithms.  Since they're written in Pascal, they're probably not too
  6. fast but they work.
  7.  
  8.  
  9. Of course they're need some tweaking.
  10. }
  11. (* NoFrills Bit-Input/Output Routines                        *)
  12. (* Insert "n" bits of data into a Buffer or Pull "n" bits of *)
  13. (* data from a buffer.  Useful for Compression routines      *)
  14.  
  15.  
  16. unit BitIO;
  17.  
  18. interface
  19.  
  20. const
  21.   BufferSize = 32767;        (* Adjust as appropriate *)
  22.  
  23. type
  24.   Buffer  = array [0..BufferSize] of byte;
  25.   BufPtr  = ^Buffer;
  26.   BuffRec = record  (* This was used for I/O by some *)
  27.     Block : BufPtr; (* other units involved with the *)
  28.     Size,           (* compression stuff. Not so     *)
  29.     Ptr   : word;   (* Important?                    *)
  30.     Loc   : byte
  31.   end;
  32.  
  33. var
  34.   InBuffer,
  35.   OutBuffer : BuffRec;
  36.   InFile,
  37.   OutFile   : file;
  38.  
  39. procedure InitBuffer(var x : BuffRec);        (* Initialize a buffer *)
  40. procedure GetBits(var b : word; num : byte);  (* Get num bits from   *)
  41.                                               (* InBuffer            *)
  42. procedure PutBits(b : word; num : byte);      (* Put num bits into   *)
  43.                                               (* OutBuffer           *)
  44. function Log2(x : word) : byte;               (* Self-explanatory... *)
  45.  
  46. implementation
  47.  
  48. const
  49.   Power : array [1..17] of longint =
  50.     (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536);
  51.  
  52. procedure InitBuffer(var x : BuffRec);
  53. begin
  54.   with x do
  55.   begin
  56.     Loc  := 8;
  57.     Ptr  := 0;
  58.     Size := 0;
  59.     New(Block);
  60.     FillChar(Block^, BufferSize, #0);
  61.   end;
  62. end;
  63.  
  64. procedure GetBits(var b : word; num : byte);
  65. var
  66.   Size : word;
  67. begin
  68.   with InBuffer do
  69.   begin
  70.     b := 0;
  71.     repeat
  72.       b := (b SHL 1);
  73.       if (Block^[Ptr] AND Power[Loc]) <> 0 then
  74.         b := b OR 1;
  75.       dec(Loc);
  76.       if Loc = 0 then
  77.       begin
  78.         Loc := 8;
  79.         inc(Ptr);
  80.       end;
  81.       dec(num);
  82.     until (num = 0);
  83.   end;
  84. end;
  85.  
  86. procedure PutBits(b : word; num : byte);
  87. var
  88.   i : byte;
  89. begin
  90.   with OutBuffer do
  91.   repeat
  92.     if Loc = 0 then
  93.     begin
  94.       inc(Ptr);
  95.       Loc := 8;
  96.     end;
  97.     if (b AND Power[num]) <> 0 then
  98.     begin
  99.       Block^[Ptr] := Block^[Ptr] OR Power[Loc];
  100.       dec(Loc);
  101.     end
  102.     else
  103.       dec(Loc);
  104.     dec(num)
  105.   until num = 0;
  106.   OutBuffer.Size := succ(OutBuffer.Ptr);
  107. end;
  108.  
  109. function Log2(x : word) : byte;
  110. var
  111.   i : byte;
  112. begin
  113.   i := 17;
  114.   while x<Power[i] do
  115.     dec(i);
  116.   Log2 := i;
  117. end;
  118.  
  119. end.
  120.